rm(list=ls())
source("funcionesKickstarter.R")
En este proyecto se analizarán datos acerca de proyectos en Kicstarter; el conjunto de datos está disponible en Kaggle y consta de 378,661 registros y 19 variables que describen, fecha de inicio y final, cantidad de patrocinadores, país de origen, monto objetivo, monto logrado en moneda local y en dólares, entre otros.
El objetivo del presente proyecto es replicar algunos resultados de este artículo y responder las siguientes preguntas.
2.1 Distribución de (monto objetivo y cantidad lograda)
Como primer paso, se realiza la lectura de datos; además, se crean tres variables; inicio, final y duración del proyecto. En la siguiente tabla se presenta una muestra de los datos.
df0 <- read.csv("ks-projects-201801.csv") %>%
mutate(inicio = as.Date(launched, format = "%Y-%m-%d"),
final = as.Date(deadline, format = "%Y-%m-%d"),
duracion = as.numeric(final - inicio))
df0 %>%
head() %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| ID | name | category | main_category | currency | deadline | goal | launched | pledged | state | backers | country | usd.pledged | usd_pledged_real | usd_goal_real | inicio | final | duracion |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1000002330 | The Songs of Adelaide & Abullah | Poetry | Publishing | GBP | 2015-10-09 | 1000 | 2015-08-11 12:12:28 | 0 | failed | 0 | GB | 0 | 0 | 1533.95 | 2015-08-11 | 2015-10-09 | 59 |
| 1000003930 | Greeting From Earth: ZGAC Arts Capsule For ET | Narrative Film | Film & Video | USD | 2017-11-01 | 30000 | 2017-09-02 04:43:57 | 2421 | failed | 15 | US | 100 | 2421 | 30000.00 | 2017-09-02 | 2017-11-01 | 60 |
| 1000004038 | Where is Hank? | Narrative Film | Film & Video | USD | 2013-02-26 | 45000 | 2013-01-12 00:20:50 | 220 | failed | 3 | US | 220 | 220 | 45000.00 | 2013-01-12 | 2013-02-26 | 45 |
| 1000007540 | ToshiCapital Rekordz Needs Help to Complete Album | Music | Music | USD | 2012-04-16 | 5000 | 2012-03-17 03:24:11 | 1 | failed | 1 | US | 1 | 1 | 5000.00 | 2012-03-17 | 2012-04-16 | 30 |
| 1000011046 | Community Film Project: The Art of Neighborhood Filmmaking | Film & Video | Film & Video | USD | 2015-08-29 | 19500 | 2015-07-04 08:35:03 | 1283 | canceled | 14 | US | 1283 | 1283 | 19500.00 | 2015-07-04 | 2015-08-29 | 56 |
| 1000014025 | Monarch Espresso Bar | Restaurants | Food | USD | 2016-04-01 | 50000 | 2016-02-26 13:38:27 | 52375 | successful | 224 | US | 52375 | 52375 | 50000.00 | 2016-02-26 | 2016-04-01 | 35 |
Ahora, se obtienen estadísticos descriptivos básicos de cada variable:
summary(df0)
## ID name category main_category
## Min. : 5971 Length:378661 Length:378661 Length:378661
## 1st Qu.: 538263516 Class :character Class :character Class :character
## Median :1075275634 Mode :character Mode :character Mode :character
## Mean :1074731192
## 3rd Qu.:1610148624
## Max. :2147476221
##
## currency deadline goal launched
## Length:378661 Length:378661 Min. : 0 Length:378661
## Class :character Class :character 1st Qu.: 2000 Class :character
## Mode :character Mode :character Median : 5200 Mode :character
## Mean : 49081
## 3rd Qu.: 16000
## Max. :100000000
##
## pledged state backers country
## Min. : 0 Length:378661 Min. : 0.0 Length:378661
## 1st Qu.: 30 Class :character 1st Qu.: 2.0 Class :character
## Median : 620 Mode :character Median : 12.0 Mode :character
## Mean : 9683 Mean : 105.6
## 3rd Qu.: 4076 3rd Qu.: 56.0
## Max. :20338986 Max. :219382.0
##
## usd.pledged usd_pledged_real usd_goal_real inicio
## Min. : 0 Min. : 0 Min. : 0 Min. :1970-01-01
## 1st Qu.: 17 1st Qu.: 31 1st Qu.: 2000 1st Qu.:2013-05-07
## Median : 395 Median : 624 Median : 5500 Median :2014-12-10
## Mean : 7037 Mean : 9059 Mean : 45454 Mean :2014-09-28
## 3rd Qu.: 3034 3rd Qu.: 4050 3rd Qu.: 15500 3rd Qu.:2016-03-24
## Max. :20338986 Max. :20338986 Max. :166361391 Max. :2018-01-02
## NA's :3797
## final duracion
## Min. :2009-05-03 Min. : 1.00
## 1st Qu.:2013-06-08 1st Qu.: 30.00
## Median :2015-01-14 Median : 30.00
## Mean :2014-11-01 Mean : 34.48
## 3rd Qu.:2016-04-28 3rd Qu.: 37.00
## Max. :2018-03-03 Max. :16739.00
##
El conjunto de datos incluye información sobre 7 campañas iniciadas en 1970; considerando que el sitio Kickstarter fue fundado en 2009, esos datos se descartarán de este análisis.
El porcentaje de datos eliminados es:
100 * length(df0[which(df0$duracion > 100), 1]) / length(df0[,1])
## [1] 0.001848619
Se eliminan los registros con fecha de inicio anterior a 2009:
df <- df0 %>%
filter(duracion <= 100)
Una de las inconsistencias detectadas es que hay campañas con 0 patrocinadores pero con monto recaudado mayor que cero; sin embargo, dado que esta variable no se utiliza en este análisis, estos datos no serán descartados.
df %>%
filter(backers == 0, usd_pledged_real >0) %>%
tally()
## n
## 1 3082
En esta parte se busca responder la siguiente pregunta: ¿La longitud de la campaña afecta en la tasa de éxito?
Según los resultados, solo el 35.4 % de las campañas logra completarse con éxito.
tabla(df$state)
| vector | Freq | Porcentaje |
|---|---|---|
| canceled | 38773 | 10.2 |
| failed | 197719 | 52.2 |
| live | 2799 | 0.7 |
| successful | 133956 | 35.4 |
| suspended | 1845 | 0.5 |
| undefined | 3562 | 0.9 |
df %>%
group_by(state) %>%
tally() -> data.fig
fig <- plot_ly(
x = data.fig$state,
y = data.fig$n / sum(data.fig$n),
type = "bar"
)
fig
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
Para fines de comparación con los resultados del artículo, la duración de la campaña se agrupa en los rangos:
df <- df %>%
arrange(duracion) %>%
mutate(rangosDuracion = case_when(
duracion <= 7 ~ "0 a 7 días",
duracion <= 22 ~ "08 a 22 días",
duracion <= 37 ~ "23 a 37 días",
duracion <= 52 ~ "38 a 52 días",
duracion <= 67 ~ "53 a 67 días",
duracion <= 82 ~ "68 a 82 días",
duracion <= 93 ~ "83 a 92 días",
TRUE ~ "Más de 92 días"))
Resumen de duración:
summary(df$duracion)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.0 30.0 30.0 34.2 37.0 92.0
El 64.3% de campañas duró entre 23 y 37 días
tabla(df$rangosDuracion)
| vector | Freq | Porcentaje |
|---|---|---|
| 0 a 7 días | 3308 | 0.9 |
| 08 a 22 días | 38077 | 10.1 |
| 23 a 37 días | 243408 | 64.3 |
| 38 a 52 días | 48145 | 12.7 |
| 53 a 67 días | 41779 | 11.0 |
| 68 a 82 días | 1020 | 0.3 |
| 83 a 92 días | 2917 | 0.8 |
Se genera una tabla de contingencia, de frecuencias, entre las variables duración (agrupada en rangos) y el estado de la campaña.
crosstab(df$state, df$rangosDuracion, Freq = TRUE)%>%
t() %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| canceled | failed | live | successful | suspended | undefined | |
|---|---|---|---|---|---|---|
| 0 a 7 días | 229 | 1618 | 5 | 1389 | 42 | 25 |
| 08 a 22 días | 2705 | 16083 | 108 | 18559 | 190 | 432 |
| 23 a 37 días | 24398 | 126379 | 1449 | 87784 | 1040 | 2358 |
| 38 a 52 días | 5546 | 25140 | 550 | 16296 | 242 | 371 |
| 53 a 67 días | 5390 | 26319 | 687 | 8685 | 323 | 375 |
| 68 a 82 días | 117 | 499 | 0 | 404 | 0 | 0 |
| 83 a 92 días | 388 | 1681 | 0 | 839 | 8 | 1 |
Ahora, la misma tabla con porcentajes:
df.tabla <- crosstab(df$state, df$rangosDuracion, Freq = FALSE)
df.tabla %>%
t() %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| canceled | failed | live | successful | suspended | undefined | |
|---|---|---|---|---|---|---|
| 0 a 7 días | 6.9 | 48.9 | 0.2 | 42.0 | 1.3 | 0.8 |
| 08 a 22 días | 7.1 | 42.2 | 0.3 | 48.7 | 0.5 | 1.1 |
| 23 a 37 días | 10.0 | 51.9 | 0.6 | 36.1 | 0.4 | 1.0 |
| 38 a 52 días | 11.5 | 52.2 | 1.1 | 33.8 | 0.5 | 0.8 |
| 53 a 67 días | 12.9 | 63.0 | 1.6 | 20.8 | 0.8 | 0.9 |
| 68 a 82 días | 11.5 | 48.9 | 0.0 | 39.6 | 0.0 | 0.0 |
| 83 a 92 días | 13.3 | 57.6 | 0.0 | 28.8 | 0.3 | 0.0 |
Comparación de tasa de éxito por estado
df.tabla <-df.tabla %>%
data.frame() %>%
filter(renglon == "successful")
fig <- plot_ly(df.tabla, x = ~columna, y = ~Freq,
type = 'scatter', mode = 'lines')
fig
De esta gráfica, se observa que los proyectos con duración entre 8 y 22 días tienen mayor tasa de éxito, seguida del grupo que dura 7 días o menos. Por otro lado, las campañas entre 53 a 67 días tienen tasa de éxito menor que el resto de grupos.
A continuación, se repican algunas gráficas del artículo de referencia.
Estadísticos descriptivos de la duración
summary(df$duracion)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.0 30.0 30.0 34.2 37.0 92.0
mfv(df$duracion)
## [1] 30
sd(df$duracion)
## [1] 12.79317
estado <- "successful"
df.cum <- df %>%
filter(state == estado) %>%
select(duracion) %>%
group_by(duracion) %>%
tally() %>%
mutate(acumulado = cumsum(n),
probabilidad = acumulado/sum(n))
plot(df.cum$probabilidad, type = "l", col = "blue",
ylab = "Probabilidad", xlab = "Duración (días)",
main = estado, xlim = c(0, 100))
estado <- "failed"
df.cum <- df %>%
filter(state == estado) %>%
select(duracion) %>%
group_by(duracion) %>%
tally() %>%
mutate(acumulado = cumsum(n),
probabilidad = acumulado/sum(n))
plot(df.cum$probabilidad, type = "l", col = "blue",
ylab = "Probabilidad", xlab = "Duración (días)",
main = estado, xlim = c(0, 100))
estado <- "exceeded goal"
df.cum <- df %>%
filter(usd_pledged_real - usd_goal_real >=0) %>%
select(duracion) %>%
group_by(duracion) %>%
tally() %>%
mutate(acumulado = cumsum(n),
probabilidad = acumulado/sum(n))
plot(df.cum$probabilidad, type = "l", col = "blue",
ylab = "Probabilidad", xlab = "Duración (días)",
main = estado, xlim = c(0, 100))
estado <- "canceled"
df.cum <- df %>%
filter(state == estado) %>%
select(duracion) %>%
group_by(duracion) %>%
tally() %>%
mutate(acumulado = cumsum(n),
probabilidad = acumulado/sum(n))
plot(df.cum$probabilidad, type = "l", col = "blue",
ylab = "Probabilidad", xlab = "Duración (días)",
main = estado, xlim = c(0, 100))
estado <- "successful"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
data.frame() %>%
filter(columna == estado)
fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "failed"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
data.frame() %>%
filter(columna == estado)
fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "canceled"
state.vs.lenght <- crosstab(df$rangosDuracion, df$state, Freq = TRUE) %>%
data.frame() %>%
filter(columna == estado)
fig <- plot_ly(state.vs.lenght, labels = ~renglon, values = ~Freq, type = 'pie')
fig <- fig %>% layout(title = estado,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
estado <- "successful"
df %>%
filter(state == estado, duracion <= 100) -> fig
hist(fig$duracion, main = estado,
ylab = "Número de campañas",
xlab = "Duración de la campaña (días)")
estado <- "failed"
df %>%
filter(state == estado, duracion <= 100) -> fig
hist(fig$duracion, main = estado,
ylab = "Número de campañas",
xlab = "Duración de la campaña (días)")
estado <- "canceled"
df %>%
filter(state == estado, duracion <= 100) -> fig
hist(fig$duracion, main = estado,
ylab = "Número de campañas",
xlab = "Duración de la campaña (días)")
¿Cuál es la relación entre el objetivo ($) y el éxito de la campaña?
2.1 Distribución de (monto objetivo y cantidad lograda)
Se agrupa el monto objetivo en los siguientes grupos
df <- df %>%
arrange(usd_goal_real) %>%
mutate(rangosGoal = case_when(
usd_goal_real <= 1000 ~ "G1 [0, 1,000]",
usd_goal_real <= 10000 ~ "G2 (1,000, 10,000]",
usd_goal_real <= 100000 ~ "G3 (10,000, 100,000]",
TRUE ~ "G4 (100,000, ...)"))
Algunos estadísticos:
df %>%
summarise(Media = mean(usd_goal_real),
Moda = mfv(usd_goal_real),
Varianza = var(usd_goal_real),
sd = sqrt(Varianza),
Mínimo = min(usd_goal_real),
Q25 = quantile(usd_goal_real, 0.25),
Mediana = median(usd_goal_real),
Q75 = quantile(usd_goal_real, 0.75),
Máximo = max(usd_goal_real),
RIC = Q75 - Q25
) %>%
t() -> goal.descriptivos
df.desc <- df %>%
group_by(rangosGoal) %>%
summarise(Media = mean(usd_goal_real),
Moda = mfv(usd_goal_real),
Varianza = var(usd_goal_real),
sd = sqrt(Varianza),
Mínimo = min(usd_goal_real),
Q25 = quantile(usd_goal_real, 0.25),
Mediana = median(usd_goal_real),
Q75 = quantile(usd_goal_real, 0.75),
Máximo = max(usd_goal_real),
RIC = Q75 - Q25
)
## `summarise()` ungrouping output (override with `.groups` argument)
nombres <- t(df.desc[, 1])
df.desc <- data.frame(t(df.desc[-1]))
colnames(df.desc) <- nombres
cbind(df.desc, General =goal.descriptivos) %>%
round(2) %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| G1 [0, 1,000] | G2 (1,000, 10,000] | G3 (10,000, 100,000] | G4 (100,000, …) | General | |
|---|---|---|---|---|---|
| Media | 576.13 | 4826.40 | 32034.50 | 998442.2 | 45455.14 |
| Moda | 1000.00 | 5000.00 | 15000.00 | 150000.0 | 5000.00 |
| Varianza | 100999.48 | 7567929.46 | 491007482.55 | 38737895287444.8 | 1329318373364.47 |
| sd | 317.80 | 2750.99 | 22158.69 | 6223977.5 | 1152960.70 |
| Mínimo | 0.01 | 1000.10 | 10001.00 | 100001.0 | 0.01 |
| Q25 | 300.00 | 2500.00 | 15000.00 | 150000.0 | 2000.00 |
| Mediana | 501.94 | 4500.00 | 25000.00 | 200771.9 | 5500.00 |
| Q75 | 900.00 | 6926.06 | 40000.00 | 400000.0 | 15500.00 |
| Máximo | 1000.00 | 10000.00 | 100000.00 | 166361390.7 | 166361390.71 |
| RIC | 600.00 | 4426.06 | 25000.00 | 250000.0 | 13500.00 |
En la siguiente tabla se muestran el monto objetivo promedio por estado; puede observarse que las campañas exitosas tienen tienen, en promedio, un objetivo menor al resto.
df %>%
group_by(state) %>%
summarise(Media = mean(usd_goal_real),
n = n())
## `summarise()` ungrouping output (override with `.groups` argument)
## # A tibble: 6 x 3
## state Media n
## <chr> <dbl> <int>
## 1 canceled 75590. 38773
## 2 failed 63175. 197719
## 3 live 62535. 2799
## 4 successful 9533. 133956
## 5 suspended 175302. 1845
## 6 undefined 4103. 3562
Resumen estadístico e histograma de usd_goal_real.
summary(df$usd_goal_real)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 2000 5500 45455 15500 166361391
hist(df$usd_goal_real, main = "Histograma: usd_goal_real",
xlab = "usd_goal_real", ylab = NULL)
Se descartan los outliers, se elimina al % de los datos extremos
alpha <- 0.01
goal1 <- descarta.outliers(df$usd_goal_real, alpha)
hist(goal1, main = "usd_goal_real sin outliers",
xlab = "usd_goal_real", ylab = NULL, freq = TRUE)
Una distribución normal no es la mejor elección para modelar el monto objetivo; sin embargo, si se ajusta al logaritmo de los datos.
ggplot(data = df, aes(x = goal1)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(goal1, na.rm = TRUE),
sd = sd(goal1, na.rm = TRUE))) +
ggtitle(paste("Histograma con curva normal teórica")) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3778 rows containing non-finite values (stat_bin).
goal1 <-log(goal1)
ggplot(data = df, aes(x = goal1)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(goal1, na.rm = TRUE),
sd = sd(goal1, na.rm = TRUE))) +
ggtitle(paste("Histograma con curva normal teórica")) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3778 rows containing non-finite values (stat_bin).
df <- df %>%
mutate(goal.alpha = descarta.outliers(usd_goal_real, alpha),
dif.goal.pledge = usd_goal_real- usd_pledged_real,
dif.alpha = descarta.outliers(dif.goal.pledge, alpha))
df.CDF <- df %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(x = ~df.CDF$usd_goal_real,
y = df.CDF$CDF, type = 'scatter', mode = 'lines')
rango = "G1 [0, 1,000]"
df.CDF <- df %>%
filter(rangosGoal == rango) %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(df.CDF, x = ~usd_goal_real,
y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
select(rangosGoal, state) %>%
filter(rangosGoal == rango) %>%
group_by(state) %>%
tally() %>%
mutate(porcentaje = n/sum(n))
fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G2 (1,000, 10,000]"
df.CDF <- df %>%
filter(rangosGoal == rango) %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(df.CDF, x = ~usd_goal_real,
y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
select(rangosGoal, state) %>%
filter(rangosGoal == rango) %>%
group_by(state) %>%
tally() %>%
mutate(porcentaje = n/sum(n))
fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G3 (10,000, 100,000]"
df.CDF <- df %>%
filter(rangosGoal == rango) %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(df.CDF, x = ~usd_goal_real,
y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
select(rangosGoal, state) %>%
filter(rangosGoal == rango) %>%
group_by(state) %>%
tally() %>%
mutate(porcentaje = n/sum(n))
fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
rango = "G4 (100,000, ...)"
df.CDF <- df %>%
filter(rangosGoal == rango) %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(df.CDF, x = ~usd_goal_real,
y = ~CDF, type = 'scatter', mode = 'lines')
fig
df.grupo <- df %>%
select(rangosGoal, state) %>%
filter(rangosGoal == rango) %>%
group_by(state) %>%
tally() %>%
mutate(porcentaje = n/sum(n))
fig <- plot_ly(df.grupo, labels = ~state, values = ~porcentaje, type = 'pie')
fig <- fig %>% layout(title = rango,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig
Se calcula la diferencia entre estas variables
ggplot(data = df, aes(x = dif.goal.pledge)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(df$dif.goal.pledge),
sd = sd(df$dif.goal.pledge))) +
ggtitle(paste("Histograma con curva normal teórica")) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Descartando outliers:
ggplot(data = df, aes(x = dif.alpha)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(df$dif.alpha, na.rm = TRUE),
sd = sd(df$dif.alpha, na.rm = TRUE))) +
ggtitle(paste("Histograma con curva normal teórica")) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 3788 rows containing non-finite values (stat_bin).
df.CDF <- df %>%
select(usd_goal_real) %>%
arrange(usd_goal_real) %>%
group_by(usd_goal_real) %>%
tally() %>%
mutate(acumulado = cumsum(n),
CDF = acumulado / sum(n))
fig <- plot_ly(df.CDF, x = ~usd_goal_real,
y = ~CDF, type = 'scatter', mode = 'lines')
fig
El 64.3% de las campañas tiene duración de 23 a 37 días y el valor con mayor frecuencia en la duración es 30 días
Las campañas con mayor tasa de éxito están en los grupos 8 a 22 días y 0 a 7 días con 48.7% y 42.0%, respectivamente.
Las campañas exitosas suelen tener monto objetivo menor al resto (9,533 USD en promedio); por otro lado, la meta de campañas fallidas y canceladas es superior a 63,000 USD.
El monto solicitado con mayor frecuencia es 5,000 USD.
Aparentemente, el monto objetivo en dólares sigue una distribución lognormal.